home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol059 / randomiz.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-13  |  3.4 KB  |  59 lines
  1. 1  '                   SELECTING A RANDOM SAMPLE
  2. 2  '               Copyright Tracy L. Gustafson, M.D.
  3. 3  '              Round Rock, Texas. Version 3.0, 1984
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  5. 15  DIM CX(10),CC(10),EX(10)
  6. 22  DATA "SELECTING A RANDOM SAMPLE",22,27
  7. 30  LOCATE 7,5:PRINT "Do you want to:":PRINT
  8. 35  PRINT TAB(10);"1.)  Select a SURVEY SAMPLE from a population.":PRINT
  9. 40  PRINT TAB(10);"2.)  Assign UNPAIRED subjects to 2 groups prospectively."
  10. 45  PRINT:PRINT TAB(10);"3.)  Assign PAIRED subjects to 2 groups prospectively."
  11. 50  LOCATE 16,20:INPUT"Enter choice:   ",ASUB:IF ABS(ASUB-2)>1 THEN BEEP:GOTO 50
  12. 55  LOCATE 20,5:INPUT "Do you want numbers printed on screen or printer? (S or P)   ",A$
  13. 60  IF A$="p" OR A$="P" THEN PO$="LPT1:":PMAX=PRNT-10 ELSE IF A$="S" OR A$="s" THEN PO$="SCRN:":PMAX=70 ELSE BEEP:GOTO 55
  14. 65  ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
  15. 70  CLS:ON ASUB GOTO 75,135,220
  16. 75  PRINT TAB(24);"SELECT A SURVEY SAMPLE":PRINT TAB(24);STRING$(22,205)
  17. 80  PRINT:PRINT TAB(15);:INPUT "What is the smallest number you want?   ",E1
  18. 85  PRINT TAB(16);:INPUT "What is the largest number you want?   ",E2
  19. 90  PRINT TAB(7);"How many random numbers between";E1;"and";E2;:INPUT "do you want?    ",NM
  20. 95  ERASE EX:DIM EX(NM+1)
  21. 100  PRINT:PRINT #1,TAB(PMAX/2-15);NM;"RANDOM NUMBERS BETWEEN";E1;"AND";E2
  22. 105  PRINT #1,:GOSUB 210:XN=NM/(E2-E1)
  23. 110  NT=1:FOR EZ=E1 TO E2:RN=RND:IF RN<XN THEN EX(NT)=EZ:NT=NT+1:IF NT>NM THEN 120
  24. 115  NEXT:IF NT<=NM THEN 110
  25. 120  TB=6:IF E2>10000 THEN TB=10
  26. 125  GOSUB 215:T=1:FOR Z=1 TO NM:PRINT #1,TAB(T);EX(Z);:T=T+TB:IF T>PMAX THEN T=1
  27. 130  NEXT:PRINT #1,:GOTO 265
  28. 135  PRINT TAB(24);"ASSIGN SUBJECTS TO TWO GROUPS":PRINT TAB(24);STRING$(29,205)
  29. 140  LOCATE 4,2:INPUT "Will subjects enter the study over a period of time longer than 1 month?  ",A$:PRINT:AF=0
  30. 145  IF A$="y" OR A$="Y" THEN AF=1:PRINT "Then it is preferable to randomize SUBSETS independently to avoid seasonal bias":PRINT TAB(15);"and to asssure equal numbers of cases and controls":PRINT TAB(23);"should the study terminate early.":PRINT
  31. 150  D1="How many subjects ":IF AF=1 THEN PRINT TAB(5);D1;:INPUT "are expected to enter the study each month?   ",NM ELSE PRINT TAB(13);D1;:INPUT "(total) will be in the study?  ",NM
  32. 155  ERASE CX,CC:DIM CX(NM/2+1),CC(NM/2+1):PRINT
  33. 160  PRINT #1,TAB(PMAX/2-13);"RANDOM ASSIGNMENT OF";NM;"SUBJECTS":PRINT #1,
  34. 165  GOSUB 210:NX=INT(NM/2)
  35. 170  NT=1:NC=1:FOR Z=1 TO NM:RN=RND:IF RN<0.5 AND NT<=NX THEN CX(NT)=Z:NT=NT+1 ELSE IF NC<=NM-NX THEN CC(NC)=Z:NC=NC+1
  36. 175  NEXT:IF NT<NX THEN 170
  37. 180  GOSUB 215:PRINT #1,"CASES = ";:T=11
  38. 185  FOR Z=1 TO NX:PRINT #1,TAB(T);CX(Z);:T=T+7:IF T>PMAX THEN T=11
  39. 190  NEXT
  40. 195  PRINT #1,:PRINT #1,:PRINT #1,"CONTROLS =";:T=11
  41. 200  FOR Z=1 TO NM-NX:PRINT #1,TAB(T);CC(Z);:T=T+7:IF T>PMAX THEN T=11
  42. 205  NEXT:PRINT #1,:GOTO 265
  43. 210  RANDOMIZE (VAL(RIGHT$(TIME$,2))):COLOR 23:AR=CSRLIN:PRINT TAB(30);"RANDOMIZING";:COLOR CLR1:RETURN
  44. 215  LOCATE AR,1:PRINT TAB(79):LOCATE AR,1:PLAY "MS O3 L64 G O2 GE L9 E":RETURN
  45. 220  PRINT TAB(18);"ASSIGN PAIRED SUBJECTS TO TWO GROUPS":PRINT TAB(18);STRING$(36,205)
  46. 225  LOCATE 4,12:INPUT "How many PAIRS of subjects are in the study?  ",NM
  47. 230  PRINT TAB(7);"Each member of a pair is assigned #1 or #2 on the basis of"
  48. 235  PRINT TAB(9);"alphabetical order or some other objective criterion."
  49. 240  PRINT #1,:PRINT #1,TAB(PMAX/2-20);"RANDOM ASSIGNMENT OF";NM;"PAIRS TO TWO GROUPS":PRINT #1,
  50. 245  PRINT #1,TAB(PMAX/3);"#1 IN PAIR";TAB(PMAX*2/3);"#2 IN PAIR"
  51. 250  RANDOMIZE VAL(RIGHT$(TIME$,2)):PRINT #1,:D1="CASE":D2="CONTROL"
  52. 255  FOR Z=1 TO NM:PRINT #1,TAB(10);Z;:RN=RND:PRINT #1,TAB(PMAX/3+2);:IF RN<0.5 THEN PRINT #1,D1;TAB(PMAX*2/3+2);D2 ELSE PRINT #1,D2;TAB(PMAX*2/3+2);D1
  53. 260  NEXT
  54. 265  CLOSE #1:LOCATE 25,15:INPUT;"Do you want to perform another randomization?  ",A$:IF A$="y" OR A$="Y" THEN 20
  55. 270  LOCATE 23,1:END
  56. 5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
  57. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  58. 5010  ON ERROR GOTO 0:END
  59.